home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Yerk / Supplement / Demo Folder / Float Demo / fpDemo < prev    next >
Encoding:
Text File  |  1986-02-25  |  5.8 KB  |  170 lines  |  [TEXT/MACA]
  1. \ grdemo - source for Curves, a simple Neon application
  2. \ 11/04/84  CBD Version 1
  3. \ 12/21/84  cbd simplified design based on new control classes
  4. \  2/18/84  cbd final for release 1.0
  5. \  2/19/86  cdn stolen from grDemo for use in floating point demo
  6.  
  7. decho -echo
  8. // Ctl
  9. // CtlWind
  10. // vScroll
  11. -> decho
  12.  
  13. \ Define a class of special vertical scroll bars that 
  14. \ always show digital values for their thumb settings.
  15. :CLASS VSCtl  <Super vScroll
  16.  
  17.     Rect    readOut     \ visible rect around readout value
  18.     Rect    viewReadOut \ view rect for readout number is inset by 4 pixels.
  19.  
  20.     \ update the digital readout of the thumb value 
  21.     :M  DISPLAY:  GetTopX: viewReadOut getBotY: viewReadOut 1- gotoxy
  22.             -curs clear: viewReadOut  Get: super  3 .R  ;M
  23.  
  24.     \ redraw the readOut rect and display the value inside
  25.     :M  DRAW:  draw: readout  display: self   ;M
  26.  
  27.     \ ( val -- )  put new thumb value, draw the readout number
  28.     :M  PUT:  put: super  display: self  ;M
  29.  
  30.     \ Build new scroll bar - window must be created 1st
  31.     :M  NEW: { left top len  wind -- } left top len wind 
  32.             New: Super  1 tmode 9 tsize 1 tfont
  33.             \ calculate the coordinates for the readOut rectangles 
  34.             left 4-  top len + 4+ dup -> len        
  35.             left 20 + len 20 + put: readOut draw: readOut
  36.             get: readOut put: viewReadOut 3 3 inset: viewReadOut  ;M
  37.  
  38. ;CLASS
  39.  
  40. \ now, build three instances of class vSctl. These will be the
  41. \ three vertical scroll bars for Curves.
  42.    VSctl Vs1      \ Radius
  43.    VSctl Vs2      \ Amplitude
  44.    VSctl Vs3      \ # cycles
  45.    VSctl Vs4      \ # passes
  46.  
  47. \ assign constants to the window corners, so that we can change
  48. \ the size of the window and the length of the scroll bars will be
  49. \ adjusted automatically.  These constants relate to the global 
  50. \ coordinates of the Macintosh screen.
  51. 20  Value gwL    
  52. 60  Value gwT
  53. 490 Value gwR
  54. 290 Value gwB
  55. gwB gwT - 80 - Value vsLen  \ len of scroll bars 
  56.  
  57.  
  58. \ Define a subclass of CtlWind containing a drawing pane.
  59. \ The window will be a RoundDoc, draggable, non-growable.
  60. :CLASS grWind  <Super CtlWind 
  61.  
  62.     Rect    thePane \ this is where we'll draw the graphics
  63.                    
  64.     \ Create a new grWind with rounded corners and title passed by caller
  65.     :M  NEW: { taddr tlen -- }  gwL gwT gwR gwB put: tempRect
  66.             tempRect tAddr tLen rndWind
  67.             true False  New: super  ;M     \ visible, no close box
  68.  
  69.     \ set defaults appropriate to this class
  70.     :M  CLASSINIT:   ClassInit: super    \ set window class defaults
  71.             false  setGrow: self  4 15 320 220 put: thePane
  72.             2 2 510 320 true setDrag: self  ;M
  73.  
  74.     \ handle an update event for this window
  75.     :M  DRAW: set: self    draw: vs1 draw: vs2  draw: vs3  draw: vs4
  76.             (abs)  call BeginUpd  (abs) call drawControls
  77.             clear: thePane draw: thePane
  78.             clip: thePane   exec: draw  \ clip to the pane and draw
  79.             (abs)  call EndUpdate 
  80.             clip: contRect      \ clip back to entire window
  81.             \ cause the scroll bars to draw their readouts
  82.     ;M
  83.  
  84.     \ Put a new draw cfa 
  85.     :M  SETDRAW:  Put: draw  ;M
  86.  
  87. ;CLASS
  88.  
  89. \ instantiate grWind to create the Curves demo window.
  90. grWind dwind
  91.  
  92. scon dTitle "Sines"    \ title for dWind
  93.  
  94. \ set the current GrafPort to fWind so that we can see what's 
  95. \ going on during the compilation.
  96. set: fwind
  97.  
  98. \ ( -- p1 p2 p3 p4 ) fetch the drawing parameters from the three scroll bars.
  99. : @dParms   get: vs1 >float
  100.             get: vs2 >float
  101.             get: vs3 >float
  102.             get: vs4 >float ;
  103.  
  104. \ store new parameter ranges for the three scroll bars.
  105. : !ranges  { max1 max2 max3 max4 -- }  
  106.      1 max1 putRange: vs1  1 max2 putRange: vs2  
  107.      0 max3 putRange: vs3  1 max4 putRange: vs4 ;
  108.  
  109. \ store starting parameter ranges for the three scroll bars.
  110. : !vals    { max1 max2 max3 max4 -- }  
  111.      max1 put: vs1  max2 put: vs2  
  112.      max3 put: vs3  max4 put: vs4 ;
  113.  
  114. \ send the New: message to the window and scroll bars.
  115. \ this creates them within the Toolbox and displays them.
  116. : newObjs  close: fWind  dTitle New: dWind   
  117.       340 40 vsLen  dWind  new: vs1  
  118.       370 40 vsLen  dWind  new: vs2 
  119.       400 40 vsLen  dWind  new: vs3
  120.       430 40 vsLen  dWind  new: vs4 ; 
  121.  
  122. scon ab1 "Sines was written in Neon™"
  123. scon ab2 "by Christopher D. Noé" 
  124. scon ab3 "of Kriya Systems, Inc."
  125.  
  126. : about  0 tfont 0 tmode 12 tsize
  127.     8 40 Gotoxy ab1 type 
  128.     cr ab2 type cr ab3 type
  129.     initFont  ;    
  130.  
  131. \ Define the actions for the various control parts.
  132. \ each action handler executes a deferred get: on the object whose
  133. \ address is on the method stack. Since the handler was called from
  134. \ the Exec: method of a vScroll object, the scroll bar's address 
  135. \ will be on the top of the mstack.  The handler then modifies the 
  136. \ value of the thumb, and causes thePane in dWind to be redrawn
  137. \ be adding its area to the current region.
  138.  
  139. : doThumb   update: dWind  ;
  140. : doPgUp    get: myCtl 10 - put: myCtl update: dWind  ; 
  141. : doPgDn    get: myCtl 10 + put: myCtl update: dWind  ; 
  142. : doLnUp    get: myCtl 1-   put: myCtl update: dWind  ; 
  143. : doLnDn    get: myCtl 1+   put: myCtl update: dWind  ; 
  144.  
  145. : doDraw    @dParms Sines ;
  146.  
  147. 'c doDraw setdraw: dwind
  148.  
  149. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs1
  150. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs2
  151. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs3
  152. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs4
  153.  
  154. \ define the menu for this application.  AppleMen is already there.
  155. 5 Menu Grafmen
  156.  
  157. \ Define the menu handler words. Each one sets a new handler
  158. \ for dWind's DRAW method, and then sets appropriate ranges and 
  159. \ titles for the scroll bars, and causes an update event.
  160.  
  161. \ startup word for the turtle graphics demo
  162. : fpStart
  163.     1000 20 gotoxy " fpMenu.txt" getmtxt
  164.     newobjs 100 100 100 100 !ranges
  165.     25 75 12 1 !vals
  166.     150. -> x 120. -> y
  167.     -echo -curs  
  168.     BEGIN key drop AGAIN    \ just loop and listen to events
  169. ;
  170.